COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	final.ans[f83,jmc]	Answers to some of the problems on CS206 final
C00004 00003	(1 ENTER ALL ((LAMBDA (Y) (ALL (FUNCTION (LAMBDA (Z) (OR (NOT (EQUAL Y 
C00008 00004	(defun cfy (x)
C00009 00005	 chehire
C00010 ENDMK
C⊗;
final.ans[f83,jmc]	Answers to some of the problems on CS206 final

(defun iscompact (x) (iscompact1 x x))
       
(defun iscompact1 (x y)
       (or (atom x)
	   (let ((z (find x y)))
		(and (or (null z) (eq z x))
		     (iscompact1 (car x) y)
		     (iscompact1 (cdr x) y)))))

(defun find (x y)
       (cond ((equal x y) y)
	     ((atom y) nil)
	     (t (let ((z (find x (car y))))
		     (if (null z) (find x (cdr y)) z)))))

(defun compactify (x) (compactify1 x nil))

(defun compactify1 (x y)
       (if (atom x)
	   x
	   (let ((z (find x y)))
		(if (not (null z))
		    z
		    (let* ((za (compactify1 (car x) y))
			   (zd (compactify1 (cdr x) (cons y za))))
			  (if (and (eq za (car x)) (eq zd (cdr x)))
			      x
			      (cons za zd)))))))

(setq a '((a.b).(a.b)))

(setq b (compactify a))

(eq (car a) (cdr b))

(defun all (p xx)
       (and (funcall p xx) (or (atom xx)
			      (and (all p (car xx)) (all p (cdr xx))))))

(defun iscompact (x)
       (all #'(lambda (y) (all #'(lambda (z) (or (not (equal y z)) (eq y z)))
			       x))
	    x))
(1 ENTER ALL ((LAMBDA (Y) (ALL (FUNCTION (LAMBDA (Z) (OR (NOT (EQUAL Y 
Z)) (EQ Y Z)))) X)) ((A . B) A . B))) 
  (2 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) ((A . B) A 
. B))) 
    (3 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) (A . B))) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) A)) 
      (4 EXIT ALL T) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) B)) 
      (4 EXIT ALL T) 
    (3 EXIT ALL T) 
    (3 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) (A . B))) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) A)) 
      (4 EXIT ALL T) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) B)) 
      (4 EXIT ALL T) 
    (3 EXIT ALL T) 
  (2 EXIT ALL T) 
  (2 ENTER ALL ((LAMBDA (Y) (ALL (FUNCTION (LAMBDA (Z) (OR (NOT (EQUAL 
Y Z)) (EQ Y Z)))) X)) (A . B))) 
    (3 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) (A . B))) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) A)) 
      (4 EXIT ALL T) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) B)) 
      (4 EXIT ALL T) 
    (3 EXIT ALL T) 
    (3 ENTER ALL ((LAMBDA (Y) (ALL (FUNCTION (LAMBDA (Z) (OR (NOT (EQUAL 
Y Z)) (EQ Y Z)))) X)) A)) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) A)) 
      (4 EXIT ALL T) 
    (3 EXIT ALL T) 
    (3 ENTER ALL ((LAMBDA (Y) (ALL (FUNCTION (LAMBDA (Z) (OR (NOT (EQUAL 
Y Z)) (EQ Y Z)))) X)) B)) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) B)) 
      (4 EXIT ALL T) 
    (3 EXIT ALL T) 
  (2 EXIT ALL T) 
  (2 ENTER ALL ((LAMBDA (Y) (ALL (FUNCTION (LAMBDA (Z) (OR (NOT (EQUAL 
Y Z)) (EQ Y Z)))) X)) (A . B))) 
    (3 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) (A . B))) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) A)) 
      (4 EXIT ALL T) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) B)) 
      (4 EXIT ALL T) 
    (3 EXIT ALL T) 
    (3 ENTER ALL ((LAMBDA (Y) (ALL (FUNCTION (LAMBDA (Z) (OR (NOT (EQUAL 
Y Z)) (EQ Y Z)))) X)) A)) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) A)) 
      (4 EXIT ALL T) 
    (3 EXIT ALL T) 
    (3 ENTER ALL ((LAMBDA (Y) (ALL (FUNCTION (LAMBDA (Z) (OR (NOT (EQUAL 
Y Z)) (EQ Y Z)))) X)) B)) 
      (4 ENTER ALL ((LAMBDA (Z) (OR (NOT (EQUAL Y Z)) (EQ Y Z))) B)) 
      (4 EXIT ALL T) 
    (3 EXIT ALL T) 
  (2 EXIT ALL T) 
(1 EXIT ALL T) 
T 
(defun cfy (x)
       (if (or (atom x) (iscompact x))
	   x
	   (cons (car (cfy2 (car x) (cdr x)))
		 (cfy (cdr (cfy2 (car x) (cdr x)))))))

(defun cfy2 (x y)
       (if (atom x)
	   x
	   (cons x (cfy3 (cdr x) (cfy3 (car x) y)))))

(defun cfy3 (x y)
       (if (null y)
	   nil
	   (cons (replace x (cfy3 x (car y))) (replace x (cfy3 x (cdr y))))))


(defun replace (x y)
       (if (or (atom x) (and (equal x y) (not (eq x y))))
	   x
	   y))

(setq a (cfy '((a.b).(a.b))))
;;; chehire

(defun compactify (x) (compactify1 x x))

(defun compactify1 (l1 l2)
       (cond ((atom l1) l2)
	     (t (compactify1 (cdr l1)
			     (compactify2 (car l1)
					  (compactify1 (car l1) l2))))))

(defun compactify2 (struct x)
       (cond ((atom x) x)
	     ((equal x struct) struct)
	     (t (rplaca x (compactify2 struct (car x)))
		(rplacd x (compactify2 struct (cdr x))))))

(iscompact (compactify '((a.b).(a.b))))
(iscompact (compactify '(((a.b).(a.b)).((a.b).(a.b)))))